home *** CD-ROM | disk | FTP | other *** search
/ Professional Soft Collection 1.02 / Professional Soft Collection 1.02.iso / msdos622.rus / msdos_4.ddi / GORILLA.BAS < prev    next >
BASIC Source File  |  1993-05-31  |  29KB  |  1,136 lines
  1. '                         Q B a s i c   G o r i l l a s
  2. '
  3. '                   Copyright (C) Microsoft Corporation 1990
  4. '
  5. ' Your mission is to hit your opponent with the exploding banana
  6. ' by varying the angle and power of your throw, taking into account
  7. ' wind speed, gravity, and the city skyline.
  8. '
  9. ' Speed of this game is determined by the constant SPEEDCONST.  If the
  10. ' program is too slow or too fast adjust the "CONST SPEEDCONST = 500" line
  11. ' below.  The larger the number the faster the game will go.
  12. '
  13. ' To run this game, press Shift+F5.
  14. '
  15. ' To exit QBasic, press Alt, F, X.
  16. '
  17. ' To get help on a BASIC keyword, move the cursor to the keyword and press
  18. ' F1 or click the right mouse button.
  19. '
  20.  
  21. 'Set default data type to integer for faster game play
  22. DEFINT A-Z
  23.  
  24. 'Sub Declarations
  25. DECLARE SUB DoSun (Mouth)
  26. DECLARE SUB SetScreen ()
  27. DECLARE SUB EndGame ()
  28. DECLARE SUB Center (Row, Text$)
  29. DECLARE SUB Intro ()
  30. DECLARE SUB SparklePause ()
  31. DECLARE SUB GetInputs (Player1$, Player2$, NumGames)
  32. DECLARE SUB PlayGame (Player1$, Player2$, NumGames)
  33. DECLARE SUB DoExplosion (x#, y#)
  34. DECLARE SUB MakeCityScape (BCoor() AS ANY)
  35. DECLARE SUB PlaceGorillas (BCoor() AS ANY)
  36. DECLARE SUB UpdateScores (Record(), PlayerNum, Results)
  37. DECLARE SUB DrawGorilla (x, y, arms)
  38. DECLARE SUB GorillaIntro (Player1$, Player2$)
  39. DECLARE SUB Rest (t#)
  40. DECLARE SUB VictoryDance (Player)
  41. DECLARE SUB ClearGorillas ()
  42. DECLARE SUB DrawBan (xc#, yc#, r, bc)
  43. DECLARE FUNCTION Scl (n!)
  44. DECLARE FUNCTION GetNum# (Row, Col)
  45. DECLARE FUNCTION DoShot (PlayerNum, x, y)
  46. DECLARE FUNCTION ExplodeGorilla (x#, y#)
  47. DECLARE FUNCTION Getn# (Row, Col)
  48. DECLARE FUNCTION PlotShot (StartX, StartY, Angle#, Velocity, PlayerNum)
  49. DECLARE FUNCTION CalcDelay! ()
  50.  
  51. 'Make all arrays Dynamic
  52. '$DYNAMIC
  53.  
  54. 'User-Defined TYPEs
  55. TYPE XYPoint
  56.   XCoor AS INTEGER
  57.   YCoor AS INTEGER
  58. END TYPE
  59.  
  60. 'Constants
  61. CONST SPEEDCONST = 500
  62. CONST TRUE = -1
  63. CONST FALSE = NOT TRUE
  64. CONST HITSELF = 1
  65. CONST BACKATTR = 0
  66. CONST OBJECTCOLOR = 1
  67. CONST WINDOWCOLOR = 14
  68. CONST SUNATTR = 3
  69. CONST SUNHAPPY = FALSE
  70. CONST SUNSHOCK = TRUE
  71. CONST RIGHTUP = 1
  72. CONST LEFTUP = 2
  73. CONST ARMSDOWN = 3
  74.  
  75. 'Global Variables
  76. DIM SHARED GorillaX(1 TO 2)  'Location of the two gorillas
  77. DIM SHARED GorillaY(1 TO 2)
  78. DIM SHARED LastBuilding
  79.  
  80. DIM SHARED pi#
  81. DIM SHARED LBan&(x), RBan&(x), UBan&(x), DBan&(x) 'Graphical picture of banana
  82. DIM SHARED GorD&(120)        'Graphical picture of Gorilla arms down
  83. DIM SHARED GorL&(120)        'Gorilla left arm raised
  84. DIM SHARED GorR&(120)        'Gorilla right arm raised
  85.  
  86. DIM SHARED gravity#
  87. DIM SHARED Wind
  88.  
  89. 'Screen Mode Variables
  90. DIM SHARED ScrHeight
  91. DIM SHARED ScrWidth
  92. DIM SHARED Mode
  93. DIM SHARED MaxCol
  94.  
  95. 'Screen Color Variables
  96. DIM SHARED ExplosionColor
  97. DIM SHARED SunColor
  98. DIM SHARED BackColor
  99. DIM SHARED SunHit
  100.  
  101. DIM SHARED SunHt
  102. DIM SHARED GHeight
  103. DIM SHARED MachSpeed AS SINGLE
  104.  
  105.   DEF FnRan (x) = INT(RND(1) * x) + 1
  106.   DEF SEG = 0                         ' Set NumLock to ON
  107.   KeyFlags = PEEK(1047)
  108.   IF (KeyFlags AND 32) = 0 THEN
  109.     POKE 1047, KeyFlags OR 32
  110.   END IF
  111.   DEF SEG
  112.  
  113.   GOSUB InitVars
  114.   Intro
  115.   GetInputs Name1$, Name2$, NumGames
  116.   GorillaIntro Name1$, Name2$
  117.   PlayGame Name1$, Name2$, NumGames
  118.  
  119.   DEF SEG = 0                         ' Restore NumLock state
  120.   POKE 1047, KeyFlags
  121.   DEF SEG
  122. END
  123.  
  124.  
  125. CGABanana:
  126.   'BananaLeft
  127.   DATA 327686, -252645316, 60
  128.   'BananaDown
  129.   DATA 196618, -1057030081, 49344
  130.   'BananaUp
  131.   DATA 196618, -1056980800, 63
  132.   'BananaRight
  133.   DATA 327686,  1010580720, 240
  134.  
  135. EGABanana:
  136.   'BananaLeft
  137.   DATA 458758,202116096,471604224,943208448,943208448,943208448,471604224,202116096,0
  138.   'BananaDown
  139.   DATA 262153, -2134835200, -2134802239, -2130771968, -2130738945,8323072, 8323199, 4063232, 4063294
  140.   'BananaUp
  141.   DATA 262153, 4063232, 4063294, 8323072, 8323199, -2130771968, -2130738945, -2134835200,-2134802239
  142.   'BananaRight
  143.   DATA 458758, -1061109760, -522133504, 1886416896, 1886416896, 1886416896,-522133504,-1061109760,0
  144.  
  145. InitVars:
  146.   pi# = 4 * ATN(1#)
  147.  
  148.   'This is a clever way to pick the best graphics mode available
  149.   ON ERROR GOTO ScreenModeError
  150.   Mode = 9
  151.   SCREEN Mode
  152.   ON ERROR GOTO PaletteError
  153.   IF Mode = 9 THEN PALETTE 4, 0   'Check for 64K EGA
  154.   ON ERROR GOTO 0
  155.  
  156.   MachSpeed = CalcDelay
  157.  
  158.   IF Mode = 9 THEN
  159.     ScrWidth = 640
  160.     ScrHeight = 350
  161.     GHeight = 25
  162.     RESTORE EGABanana
  163.     REDIM LBan&(8), RBan&(8), UBan&(8), DBan&(8)
  164.  
  165.     FOR i = 0 TO 8
  166.       READ LBan&(i)
  167.     NEXT i
  168.  
  169.     FOR i = 0 TO 8
  170.       READ DBan&(i)
  171.     NEXT i
  172.  
  173.     FOR i = 0 TO 8
  174.       READ UBan&(i)
  175.     NEXT i
  176.  
  177.     FOR i = 0 TO 8
  178.       READ RBan&(i)
  179.     NEXT i
  180.  
  181.     SunHt = 39
  182.  
  183.   ELSE
  184.  
  185.     ScrWidth = 320
  186.     ScrHeight = 200
  187.     GHeight = 12
  188.     RESTORE CGABanana
  189.     REDIM LBan&(2), RBan&(2), UBan&(2), DBan&(2)
  190.     REDIM GorL&(20), GorD&(20), GorR&(20)
  191.  
  192.     FOR i = 0 TO 2
  193.       READ LBan&(i)
  194.     NEXT i
  195.     FOR i = 0 TO 2
  196.       READ DBan&(i)
  197.     NEXT i
  198.     FOR i = 0 TO 2
  199.       READ UBan&(i)
  200.     NEXT i
  201.     FOR i = 0 TO 2
  202.       READ RBan&(i)
  203.     NEXT i
  204.  
  205.     MachSpeed = MachSpeed * 1.3
  206.     SunHt = 20
  207.   END IF
  208. RETURN
  209.  
  210. ScreenModeError:
  211.   IF Mode = 1 THEN
  212.     CLS
  213.     LOCATE 10, 5
  214.     PRINT "Sorry, you must have CGA, EGA color, or VGA graphics to play GORILLA.BAS"
  215.     END
  216.   ELSE
  217.     Mode = 1
  218.     RESUME
  219.   END IF
  220.  
  221. PaletteError:
  222.   Mode = 1            '64K EGA cards will run in CGA mode.
  223.   RESUME NEXT
  224.  
  225. REM $STATIC
  226. 'CalcDelay:
  227. '  Checks speed of the machine.
  228. FUNCTION CalcDelay!
  229.  
  230.   s! = TIMER
  231.   DO
  232.     i! = i! + 1
  233.   LOOP UNTIL TIMER - s! >= .5
  234.   CalcDelay! = i!
  235.  
  236. END FUNCTION
  237.  
  238. ' Center:
  239. '   Centers and prints a text string on a given row
  240. ' Parameters:
  241. '   Row - screen row number
  242. '   Text$ - text to be printed
  243. '
  244. SUB Center (Row, Text$)
  245.   Col = MaxCol \ 2
  246.   LOCATE Row, Col - (LEN(Text$) / 2 + .5)
  247.   PRINT Text$;
  248. END SUB
  249.  
  250. ' DoExplosion:
  251. '   Produces explosion when a shot is fired
  252. ' Parameters:
  253. '   X#, Y# - location of explosion
  254. '
  255. SUB DoExplosion (x#, y#)
  256.  
  257.   PLAY "MBO0L32EFGEFDC"
  258.   Radius = ScrHeight / 50
  259.   IF Mode = 9 THEN Inc# = .5 ELSE Inc# = .41
  260.   FOR c# = 0 TO Radius STEP Inc#
  261.     CIRCLE (x#, y#), c#, ExplosionColor
  262.   NEXT c#
  263.   FOR c# = Radius TO 0 STEP (-1 * Inc#)
  264.     CIRCLE (x#, y#), c#, BACKATTR
  265.     FOR i = 1 TO 100
  266.     NEXT i
  267.     Rest .005
  268.   NEXT c#
  269. END SUB
  270.  
  271. ' DoShot:
  272. '   Controls banana shots by accepting player input and plotting
  273. '   shot angle
  274. ' Parameters:
  275. '   PlayerNum - Player
  276. '   x, y - Player's gorilla position
  277. '
  278. FUNCTION DoShot (PlayerNum, x, y)
  279.  
  280.   'Input shot
  281.   IF PlayerNum = 1 THEN
  282.     LocateCol = 1
  283.   ELSE
  284.     IF Mode = 9 THEN
  285.       LocateCol = 66
  286.     ELSE
  287.       LocateCol = 26
  288.     END IF
  289.   END IF
  290.  
  291.   LOCATE 2, LocateCol
  292.   PRINT "Angle:";
  293.   Angle# = GetNum#(2, LocateCol + 7)
  294.  
  295.   LOCATE 3, LocateCol
  296.   PRINT "Velocity:";
  297.   Velocity = GetNum#(3, LocateCol + 10)
  298.  
  299.   IF PlayerNum = 2 THEN
  300.     Angle# = 180 - Angle#
  301.   END IF
  302.  
  303.   'Erase input
  304.   FOR i = 1 TO 4
  305.     LOCATE i, 1
  306.     PRINT SPACE$(30 \ (80 \ MaxCol));
  307.     LOCATE i, (50 \ (80 \ MaxCol))
  308.     PRINT SPACE$(30 \ (80 \ MaxCol));
  309.   NEXT
  310.  
  311.   SunHit = FALSE
  312.   PlayerHit = PlotShot(x, y, Angle#, Velocity, PlayerNum)
  313.   IF PlayerHit = 0 THEN
  314.     DoShot = FALSE
  315.   ELSE
  316.     DoShot = TRUE
  317.     IF PlayerHit = PlayerNum THEN PlayerNum = 3 - PlayerNum
  318.     VictoryDance PlayerNum
  319.   END IF
  320.  
  321. END FUNCTION
  322.  
  323. ' DoSun:
  324. '   Draws the sun at the top of the screen.
  325. ' Parameters:
  326. '   Mouth - If TRUE draws "O" mouth else draws a smile mouth.
  327. '
  328. SUB DoSun (Mouth)
  329.  
  330.   'set position of sun
  331.   x = ScrWidth \ 2: y = Scl(25)
  332.  
  333.   'clear old sun
  334.   LINE (x - Scl(22), y - Scl(18))-(x + Scl(22), y + Scl(18)), BACKATTR, BF
  335.  
  336.   'draw new sun:
  337.   'body
  338.   CIRCLE (x, y), Scl(12), SUNATTR
  339.   PAINT (x, y), SUNATTR
  340.  
  341.   'rays
  342.   LINE (x - Scl(20), y)-(x + Scl(20), y), SUNATTR
  343.   LINE (x, y - Scl(15))-(x, y + Scl(15)), SUNATTR
  344.  
  345.   LINE (x - Scl(15), y - Scl(10))-(x + Scl(15), y + Scl(10)), SUNATTR
  346.   LINE (x - Scl(15), y + Scl(10))-(x + Scl(15), y - Scl(10)), SUNATTR
  347.  
  348.   LINE (x - Scl(8), y - Scl(13))-(x + Scl(8), y + Scl(13)), SUNATTR
  349.   LINE (x - Scl(8), y + Scl(13))-(x + Scl(8), y - Scl(13)), SUNATTR
  350.  
  351.   LINE (x - Scl(18), y - Scl(5))-(x + Scl(18), y + Scl(5)), SUNATTR
  352.   LINE (x - Scl(18), y + Scl(5))-(x + Scl(18), y - Scl(5)), SUNATTR
  353.  
  354.   'mouth
  355.   IF Mouth THEN  'draw "o" mouth
  356.     CIRCLE (x, y + Scl(5)), Scl(2.9), 0
  357.     PAINT (x, y + Scl(5)), 0, 0
  358.   ELSE           'draw smile
  359.     CIRCLE (x, y), Scl(8), 0, (210 * pi# / 180), (330 * pi# / 180)
  360.   END IF
  361.  
  362.   'eyes
  363.   CIRCLE (x - 3, y - 2), 1, 0
  364.   CIRCLE (x + 3, y - 2), 1, 0
  365.   PSET (x - 3, y - 2), 0
  366.   PSET (x + 3, y - 2), 0
  367.  
  368. END SUB
  369.  
  370. 'DrawBan:
  371. '  Draws the banana
  372. 'Parameters:
  373. '  xc# - Horizontal Coordinate
  374. '  yc# - Vertical Coordinate
  375. '  r - rotation position (0-3). (  \_/  ) /-\
  376. '  bc - if TRUE then DrawBan draws the banana ELSE it erases the banana
  377. SUB DrawBan (xc#, yc#, r, bc)
  378.  
  379. SELECT CASE r
  380.   CASE 0
  381.     IF bc THEN PUT (xc#, yc#), LBan&, PSET ELSE PUT (xc#, yc#), LBan&, XOR
  382.   CASE 1
  383.     IF bc THEN PUT (xc#, yc#), UBan&, PSET ELSE PUT (xc#, yc#), UBan&, XOR
  384.   CASE 2
  385.     IF bc THEN PUT (xc#, yc#), DBan&, PSET ELSE PUT (xc#, yc#), DBan&, XOR
  386.   CASE 3
  387.     IF bc THEN PUT (xc#, yc#), RBan&, PSET ELSE PUT (xc#, yc#), RBan&, XOR
  388. END SELECT
  389.  
  390. END SUB
  391.  
  392. 'DrawGorilla:
  393. '  Draws the Gorilla in either CGA or EGA mode
  394. '  and saves the graphics data in an array.
  395. 'Parameters:
  396. '  x - x coordinate of gorilla
  397. '  y - y coordinate of the gorilla
  398. '  arms - either Left up, Right up, or both down
  399. SUB DrawGorilla (x, y, arms)
  400.   DIM i AS SINGLE   ' Local index must be single precision
  401.  
  402.   'draw head
  403.   LINE (x - Scl(4), y)-(x + Scl(2.9), y + Scl(6)), OBJECTCOLOR, BF
  404.   LINE (x - Scl(5), y + Scl(2))-(x + Scl(4), y + Scl(4)), OBJECTCOLOR, BF
  405.  
  406.   'draw eyes/brow
  407.   LINE (x - Scl(3), y + Scl(2))-(x + Scl(2), y + Scl(2)), 0
  408.  
  409.   'draw nose if ega
  410.   IF Mode = 9 THEN
  411.     FOR i = -2 TO -1
  412.       PSET (x + i, y + 4), 0
  413.       PSET (x + i + 3, y + 4), 0
  414.     NEXT i
  415.   END IF
  416.  
  417.   'neck
  418.   LINE (x - Scl(3), y + Scl(7))-(x + Scl(2), y + Scl(7)), OBJECTCOLOR
  419.  
  420.   'body
  421.   LINE (x - Scl(8), y + Scl(8))-(x + Scl(6.9), y + Scl(14)), OBJECTCOLOR, BF
  422.   LINE (x - Scl(6), y + Scl(15))-(x + Scl(4.9), y + Scl(20)), OBJECTCOLOR, BF
  423.  
  424.   'legs
  425.   FOR i = 0 TO 4
  426.     CIRCLE (x + Scl(i), y + Scl(25)), Scl(10), OBJECTCOLOR, 3 * pi# / 4, 9 * pi# / 8
  427.     CIRCLE (x + Scl(-6) + Scl(i - .1), y + Scl(25)), Scl(10), OBJECTCOLOR, 15 * pi# / 8, pi# / 4
  428.   NEXT
  429.  
  430.   'chest
  431.   CIRCLE (x - Scl(4.9), y + Scl(10)), Scl(4.9), 0, 3 * pi# / 2, 0
  432.   CIRCLE (x + Scl(4.9), y + Scl(10)), Scl(4.9), 0, pi#, 3 * pi# / 2
  433.  
  434.   FOR i = -5 TO -1
  435.     SELECT CASE arms
  436.       CASE 1
  437.         'Right arm up
  438.         CIRCLE (x + Scl(i - .1), y + Scl(14)), Scl(9), OBJECTCOLOR, 3 * pi# / 4, 5 * pi# / 4
  439.         CIRCLE (x + Scl(4.9) + Scl(i), y + Scl(4)), Scl(9), OBJECTCOLOR, 7 * pi# / 4, pi# / 4
  440.         GET (x - Scl(15), y - Scl(1))-(x + Scl(14), y + Scl(28)), GorR&
  441.       CASE 2
  442.         'Left arm up
  443.         CIRCLE (x + Scl(i - .1), y + Scl(4)), Scl(9), OBJECTCOLOR, 3 * pi# / 4, 5 * pi# / 4
  444.         CIRCLE (x + Scl(4.9) + Scl(i), y + Scl(14)), Scl(9), OBJECTCOLOR, 7 * pi# / 4, pi# / 4
  445.         GET (x - Scl(15), y - Scl(1))-(x + Scl(14), y + Scl(28)), GorL&
  446.       CASE 3
  447.         'Both arms down
  448.         CIRCLE (x + Scl(i - .1), y + Scl(14)), Scl(9), OBJECTCOLOR, 3 * pi# / 4, 5 * pi# / 4
  449.         CIRCLE (x + Scl(4.9) + Scl(i), y + Scl(14)), Scl(9), OBJECTCOLOR, 7 * pi# / 4, pi# / 4
  450.         GET (x - Scl(15), y - Scl(1))-(x + Scl(14), y + Scl(28)), GorD&
  451.     END SELECT
  452.   NEXT i
  453. END SUB
  454.  
  455. 'ExplodeGorilla:
  456. '  Causes gorilla explosion when a direct hit occurs
  457. 'Parameters:
  458. '  X#, Y# - shot location
  459. FUNCTION ExplodeGorilla (x#, y#)
  460.   YAdj = Scl(12)
  461.   XAdj = Scl(5)
  462.   SclX# = ScrWidth / 320
  463.   SclY# = ScrHeight / 200
  464.   IF x# < ScrWidth / 2 THEN PlayerHit = 1 ELSE PlayerHit = 2
  465.   PLAY "MBO0L16EFGEFDC"
  466.  
  467.   FOR i = 1 TO 8 * SclX#
  468.     CIRCLE (GorillaX(PlayerHit) + 3.5 * SclX# + XAdj, GorillaY(PlayerHit) + 7 * SclY# + YAdj), i, ExplosionColor, , , -1.57
  469.     LINE (GorillaX(PlayerHit) + 7 * SclX#, GorillaY(PlayerHit) + 9 * SclY# - i)-(GorillaX(PlayerHit), GorillaY(PlayerHit) + 9 * SclY# - i), ExplosionColor
  470.   NEXT i
  471.  
  472.   FOR i = 1 TO 16 * SclX#
  473.     IF i < (8 * SclX#) THEN CIRCLE (GorillaX(PlayerHit) + 3.5 * SclX# + XAdj, GorillaY(PlayerHit) + 7 * SclY# + YAdj), (8 * SclX# + 1) - i, BACKATTR, , , -1.57
  474.     CIRCLE (GorillaX(PlayerHit) + 3.5 * SclX# + XAdj, GorillaY(PlayerHit) + YAdj), i, i MOD 2 + 1, , , -1.57
  475.   NEXT i
  476.  
  477.   FOR i = 24 * SclX# TO 1 STEP -1
  478.     CIRCLE (GorillaX(PlayerHit) + 3.5 * SclX# + XAdj, GorillaY(PlayerHit) + YAdj), i, BACKATTR, , , -1.57
  479.     FOR Count = 1 TO 200
  480.     NEXT
  481.   NEXT i
  482.  
  483.   ExplodeGorilla = PlayerHit
  484. END FUNCTION
  485.  
  486. 'GetInputs:
  487. '  Gets user inputs at beginning of game
  488. 'Parameters:
  489. '  Player1$, Player2$ - player names
  490. '  NumGames - number of games to play
  491. SUB GetInputs (Player1$, Player2$, NumGames)
  492.   COLOR 7, 0
  493.   CLS
  494.  
  495.   LOCATE 8, 15
  496.   LINE INPUT "Name of Player 1 (Default = 'Player 1'): "; Player1$
  497.   IF Player1$ = "" THEN
  498.     Player1$ = "Player 1"
  499.   ELSE
  500.     Player1$ = LEFT$(Player1$, 10)
  501.   END IF
  502.  
  503.   LOCATE 10, 15
  504.   LINE INPUT "Name of Player 2 (Default = 'Player 2'): "; Player2$
  505.   IF Player2$ = "" THEN
  506.     Player2$ = "Player 2"
  507.   ELSE
  508.     Player2$ = LEFT$(Player2$, 10)
  509.   END IF
  510.  
  511.   DO
  512.     LOCATE 12, 56: PRINT SPACE$(25);
  513.     LOCATE 12, 13
  514.     INPUT "Play to how many total points (Default = 3)"; game$
  515.     NumGames = VAL(LEFT$(game$, 2))
  516.   LOOP UNTIL NumGames > 0 AND LEN(game$) < 3 OR LEN(game$) = 0
  517.   IF NumGames = 0 THEN NumGames = 3
  518.  
  519.   DO
  520.     LOCATE 14, 53: PRINT SPACE$(28);
  521.     LOCATE 14, 17
  522.     INPUT "Gravity in Meters/Sec (Earth = 9.8)"; grav$
  523.     gravity# = VAL(grav$)
  524.   LOOP UNTIL gravity# > 0 OR LEN(grav$) = 0
  525.   IF gravity# = 0 THEN gravity# = 9.8
  526. END SUB
  527.  
  528. 'GetNum:
  529. '  Gets valid numeric input from user
  530. 'Parameters:
  531. '  Row, Col - location to echo input
  532. FUNCTION GetNum# (Row, Col)
  533.   Result$ = ""
  534.   Done = FALSE
  535.   WHILE INKEY$ <> "": WEND   'Clear keyboard buffer
  536.  
  537.   DO WHILE NOT Done
  538.  
  539.     LOCATE Row, Col
  540.     PRINT Result$; CHR$(95); "    ";
  541.  
  542.     Kbd$ = INKEY$
  543.     SELECT CASE Kbd$
  544.       CASE "0" TO "9"
  545.         Result$ = Result$ + Kbd$
  546.       CASE "."
  547.         IF INSTR(Result$, ".") = 0 THEN
  548.           Result$ = Result$ + Kbd$
  549.         END IF
  550.       CASE CHR$(13)
  551.         IF VAL(Result$) > 360 THEN
  552.           Result$ = ""
  553.         ELSE
  554.           Done = TRUE
  555.         END IF
  556.       CASE CHR$(8)
  557.         IF LEN(Result$) > 0 THEN
  558.           Result$ = LEFT$(Result$, LEN(Result$) - 1)
  559.         END IF
  560.       CASE ELSE
  561.         IF LEN(Kbd$) > 0 THEN
  562.           BEEP
  563.         END IF
  564.       END SELECT
  565.   LOOP
  566.  
  567.   LOCATE Row, Col
  568.   PRINT Result$; " ";
  569.  
  570.   GetNum# = VAL(Result$)
  571. END FUNCTION
  572.  
  573. 'GorillaIntro:
  574. '  Displays gorillas on screen for the first time
  575. '  allows the graphical data to be put into an array
  576. 'Parameters:
  577. '  Player1$, Player2$ - The names of the players
  578. '
  579. SUB GorillaIntro (Player1$, Player2$)
  580.   LOCATE 16, 34: PRINT "--------------"
  581.   LOCATE 18, 34: PRINT "V = View Intro"
  582.   LOCATE 19, 34: PRINT "P = Play Game"
  583.   LOCATE 21, 35: PRINT "Your Choice?"
  584.  
  585.   DO WHILE Char$ = ""
  586.     Char$ = INKEY$
  587.   LOOP
  588.  
  589.   IF Mode = 1 THEN
  590.     x = 125
  591.     y = 100
  592.   ELSE
  593.     x = 278
  594.     y = 175
  595.   END IF
  596.  
  597.   SCREEN Mode
  598.   SetScreen
  599.  
  600.   IF Mode = 1 THEN Center 5, "Please wait while gorillas are drawn."
  601.  
  602.   VIEW PRINT 9 TO 24
  603.  
  604.   IF Mode = 9 THEN PALETTE OBJECTCOLOR, BackColor
  605.  
  606.   DrawGorilla x, y, ARMSDOWN
  607.   CLS 2
  608.   DrawGorilla x, y, LEFTUP
  609.   CLS 2
  610.   DrawGorilla x, y, RIGHTUP
  611.   CLS 2
  612.  
  613.   VIEW PRINT 1 TO 25
  614.   IF Mode = 9 THEN PALETTE OBJECTCOLOR, 46
  615.  
  616.   IF UCASE$(Char$) = "V" THEN
  617.     Center 2, "Q B A S I C   G O R I L L A S"
  618.     Center 5, "             STARRING:               "
  619.     P$ = Player1$ + " AND " + Player2$
  620.     Center 7, P$
  621.  
  622.     PUT (x - 13, y), GorD&, PSET
  623.     PUT (x + 47, y), GorD&, PSET
  624.     Rest 1
  625.  
  626.     PUT (x - 13, y), GorL&, PSET
  627.     PUT (x + 47, y), GorR&, PSET
  628.     PLAY "t120o1l16b9n0baan0bn0bn0baaan0b9n0baan0b"
  629.     Rest .3
  630.  
  631.     PUT (x - 13, y), GorR&, PSET
  632.     PUT (x + 47, y), GorL&, PSET
  633.     PLAY "o2l16e-9n0e-d-d-n0e-n0e-n0e-d-d-d-n0e-9n0e-d-d-n0e-"
  634.     Rest .3
  635.  
  636.     PUT (x - 13, y), GorL&, PSET
  637.     PUT (x + 47, y), GorR&, PSET
  638.     PLAY "o2l16g-9n0g-een0g-n0g-n0g-eeen0g-9n0g-een0g-"
  639.     Rest .3
  640.  
  641.     PUT (x - 13, y), GorR&, PSET
  642.     PUT (x + 47, y), GorL&, PSET
  643.     PLAY "o2l16b9n0baan0g-n0g-n0g-eeen0o1b9n0baan0b"
  644.     Rest .3
  645.  
  646.     FOR i = 1 TO 4
  647.       PUT (x - 13, y), GorL&, PSET
  648.       PUT (x + 47, y), GorR&, PSET
  649.       PLAY "T160O0L32EFGEFDC"
  650.       Rest .1
  651.       PUT (x - 13, y), GorR&, PSET
  652.       PUT (x + 47, y), GorL&, PSET
  653.       PLAY "T160O0L32EFGEFDC"
  654.       Rest .1
  655.     NEXT
  656.   END IF
  657. END SUB
  658.  
  659. 'Intro:
  660. '  Displays game introduction
  661. SUB Intro
  662.  
  663.   SCREEN 0
  664.   WIDTH 80, 25
  665.   MaxCol = 80
  666.   COLOR 15, 0
  667.   CLS
  668.  
  669.   Center 4, "Q B a s i c    G O R I L L A S"
  670.   COLOR 7
  671.   Center 6, "Copyright (C) Microsoft Corporation 1990"
  672.   Center 8, "Your mission is to hit your opponent with the exploding"
  673.   Center 9, "banana by varying the angle and power of your throw, taking"
  674.   Center 10, "into account wind speed, gravity, and the city skyline."
  675.   Center 11, "The wind speed is shown by a directional arrow at the bottom"
  676.   Center 12, "of the playing field, its length relative to its strength."
  677.   Center 24, "Press any key to continue"
  678.  
  679.   PLAY "MBT160O1L8CDEDCDL4ECC"
  680.   SparklePause
  681.   IF Mode = 1 THEN MaxCol = 40
  682. END SUB
  683.  
  684. 'MakeCityScape:
  685. '  Creates random skyline for game
  686. 'Parameters:
  687. '  BCoor() - a user-defined type array which stores the coordinates of
  688. '  the upper left corner of each building.
  689. SUB MakeCityScape (BCoor() AS XYPoint)
  690.  
  691.   x = 2
  692.  
  693.   'Set the sloping trend of the city scape. NewHt is new building height
  694.   Slope = FnRan(6)
  695.   SELECT CASE Slope
  696.     CASE 1: NewHt = 15                 'Upward slope
  697.     CASE 2: NewHt = 130                'Downward slope
  698.     CASE 3 TO 5: NewHt = 15            '"V" slope - most common
  699.     CASE 6: NewHt = 130                'Inverted "V" slope
  700.   END SELECT
  701.  
  702.   IF Mode = 9 THEN
  703.     BottomLine = 335                   'Bottom of building
  704.     HtInc = 10                         'Increase value for new height
  705.     DefBWidth = 37                     'Default building height
  706.     RandomHeight = 120                 'Random height difference
  707.     WWidth = 3                         'Window width
  708.     WHeight = 6                        'Window height
  709.     WDifV = 15                         'Counter for window spacing - vertical
  710.     WDifh = 10                         'Counter for window spacing - horizontal
  711.   ELSE
  712.     BottomLine = 190
  713.     HtInc = 6
  714.     NewHt = NewHt * 20 \ 35            'Adjust for CGA
  715.     DefBWidth = 18
  716.     RandomHeight = 54
  717.     WWidth = 1
  718.     WHeight = 2
  719.     WDifV = 5
  720.     WDifh = 4
  721.   END IF
  722.  
  723.   CurBuilding = 1
  724.   DO
  725.  
  726.     SELECT CASE Slope
  727.       CASE 1
  728.         NewHt = NewHt + HtInc
  729.       CASE 2
  730.         NewHt = NewHt - HtInc
  731.       CASE 3 TO 5
  732.         IF x > ScrWidth \ 2 THEN
  733.           NewHt = NewHt - 2 * HtInc
  734.         ELSE
  735.           NewHt = NewHt + 2 * HtInc
  736.         END IF
  737.       CASE 4
  738.         IF x > ScrWidth \ 2 THEN
  739.           NewHt = NewHt + 2 * HtInc
  740.         ELSE
  741.           NewHt = NewHt - 2 * HtInc
  742.         END IF
  743.     END SELECT
  744.  
  745.     'Set width of building and check to see if it would go off the screen
  746.     BWidth = FnRan(DefBWidth) + DefBWidth
  747.     IF x + BWidth > ScrWidth THEN BWidth = ScrWidth - x - 2
  748.  
  749.     'Set height of building and check to see if it goes below screen
  750.     BHeight = FnRan(RandomHeight) + NewHt
  751.     IF BHeight < HtInc THEN BHeight = HtInc
  752.  
  753.     'Check to see if Building is too high
  754.     IF BottomLine - BHeight <= MaxHeight + GHeight THEN BHeight = MaxHeight + GHeight - 5
  755.  
  756.     'Set the coordinates of the building into the array
  757.     BCoor(CurBuilding).XCoor = x
  758.     BCoor(CurBuilding).YCoor = BottomLine - BHeight
  759.  
  760.     IF Mode = 9 THEN BuildingColor = FnRan(3) + 4 ELSE BuildingColor = 2
  761.  
  762.     'Draw the building, outline first, then filled
  763.     LINE (x - 1, BottomLine + 1)-(x + BWidth + 1, BottomLine - BHeight - 1), BACKGROUND, B
  764.     LINE (x, BottomLine)-(x + BWidth, BottomLine - BHeight), BuildingColor, BF
  765.  
  766.     'Draw the windows
  767.     c = x + 3
  768.     DO
  769.       FOR i = BHeight - 3 TO 7 STEP -WDifV
  770.         IF Mode <> 9 THEN
  771.           WinColr = (FnRan(2) - 2) * -3
  772.         ELSEIF FnRan(4) = 1 THEN
  773.           WinColr = 8
  774.         ELSE
  775.           WinColr = WINDOWCOLOR
  776.         END IF
  777.         LINE (c, BottomLine - i)-(c + WWidth, BottomLine - i + WHeight), WinColr, BF
  778.       NEXT
  779.       c = c + WDifh
  780.     LOOP UNTIL c >= x + BWidth - 3
  781.  
  782.     x = x + BWidth + 2
  783.  
  784.     CurBuilding = CurBuilding + 1
  785.  
  786.   LOOP UNTIL x > ScrWidth - HtInc
  787.  
  788.   LastBuilding = CurBuilding - 1
  789.  
  790.   'Set Wind speed
  791.   Wind = FnRan(10) - 5
  792.   IF FnRan(3) = 1 THEN
  793.     IF Wind > 0 THEN
  794.       Wind = Wind + FnRan(10)
  795.     ELSE
  796.       Wind = Wind - FnRan(10)
  797.     END IF
  798.   END IF
  799.  
  800.   'Draw Wind speed arrow
  801.   IF Wind <> 0 THEN
  802.     WindLine = Wind * 3 * (ScrWidth \ 320)
  803.     LINE (ScrWidth \ 2, ScrHeight - 5)-(ScrWidth \ 2 + WindLine, ScrHeight - 5), ExplosionColor
  804.     IF Wind > 0 THEN ArrowDir = -2 ELSE ArrowDir = 2
  805.     LINE (ScrWidth / 2 + WindLine, ScrHeight - 5)-(ScrWidth / 2 + WindLine + ArrowDir, ScrHeight - 5 - 2), ExplosionColor
  806.     LINE (ScrWidth / 2 + WindLine, ScrHeight - 5)-(ScrWidth / 2 + WindLine + ArrowDir, ScrHeight - 5 + 2), ExplosionColor
  807.   END IF
  808. END SUB
  809.  
  810. 'PlaceGorillas:
  811. '  PUTs the Gorillas on top of the buildings.  Must have drawn
  812. '  Gorillas first.
  813. 'Parameters:
  814. '  BCoor() - user-defined TYPE array which stores upper left coordinates
  815. '  of each building.
  816. SUB PlaceGorillas (BCoor() AS XYPoint)
  817.     
  818.   IF Mode = 9 THEN
  819.     XAdj = 14
  820.     YAdj = 30
  821.   ELSE
  822.     XAdj = 7
  823.     YAdj = 16
  824.   END IF
  825.   SclX# = ScrWidth / 320
  826.   SclY# = ScrHeight / 200
  827.     
  828.   'Place gorillas on second or third building from edge
  829.   FOR i = 1 TO 2
  830.     IF i = 1 THEN BNum = FnRan(2) + 1 ELSE BNum = LastBuilding - FnRan(2)
  831.  
  832.     BWidth = BCoor(BNum + 1).XCoor - BCoor(BNum).XCoor
  833.     GorillaX(i) = BCoor(BNum).XCoor + BWidth / 2 - XAdj
  834.     GorillaY(i) = BCoor(BNum).YCoor - YAdj
  835.     PUT (GorillaX(i), GorillaY(i)), GorD&, PSET
  836.   NEXT i
  837.  
  838. END SUB
  839.  
  840. 'PlayGame:
  841. '  Main game play routine
  842. 'Parameters:
  843. '  Player1$, Player2$ - player names
  844. '  NumGames - number of games to play
  845. SUB PlayGame (Player1$, Player2$, NumGames)
  846.   DIM BCoor(0 TO 30) AS XYPoint
  847.   DIM TotalWins(1 TO 2)
  848.  
  849.   J = 1
  850.   
  851.   FOR i = 1 TO NumGames
  852.     
  853.     CLS
  854.     RANDOMIZE (TIMER)
  855.     CALL MakeCityScape(BCoor())
  856.     CALL PlaceGorillas(BCoor())
  857.     DoSun SUNHAPPY
  858.     Hit = FALSE
  859.     DO WHILE Hit = FALSE
  860.       J = 1 - J
  861.       LOCATE 1, 1
  862.       PRINT Player1$
  863.       LOCATE 1, (MaxCol - 1 - LEN(Player2$))
  864.       PRINT Player2$
  865.       Center 23, LTRIM$(STR$(TotalWins(1))) + ">Score<" + LTRIM$(STR$(TotalWins(2)))
  866.       Tosser = J + 1: Tossee = 3 - J
  867.  
  868.       'Plot the shot.  Hit is true if Gorilla gets hit.
  869.       Hit = DoShot(Tosser, GorillaX(Tosser), GorillaY(Tosser))
  870.  
  871.       'Reset the sun, if it got hit
  872.       IF SunHit THEN DoSun SUNHAPPY
  873.  
  874.       IF Hit = TRUE THEN CALL UpdateScores(TotalWins(), Tosser, Hit)
  875.     LOOP
  876.     SLEEP 1
  877.   NEXT i
  878.  
  879.   SCREEN 0
  880.   WIDTH 80, 25
  881.   COLOR 7, 0
  882.   MaxCol = 80
  883.   CLS
  884.  
  885.   Center 8, "GAME OVER!"
  886.   Center 10, "Score:"
  887.   LOCATE 11, 30: PRINT Player1$; TAB(50); TotalWins(1)
  888.   LOCATE 12, 30: PRINT Player2$; TAB(50); TotalWins(2)
  889.   Center 24, "Press any key to continue"
  890.   SparklePause
  891.   COLOR 7, 0
  892.   CLS
  893. END SUB
  894.  
  895. 'PlayGame:
  896. '  Plots banana shot across the screen
  897. 'Parameters:
  898. '  StartX, StartY - starting shot location
  899. '  Angle - shot angle
  900. '  Velocity - shot velocity
  901. '  PlayerNum - the banana thrower
  902. FUNCTION PlotShot (StartX, StartY, Angle#, Velocity, PlayerNum)
  903.  
  904.   Angle# = Angle# / 180 * pi#  'Convert degree angle to radians
  905.   Radius = Mode MOD 7
  906.  
  907.   InitXVel# = COS(Angle#) * Velocity
  908.   InitYVel# = SIN(Angle#) * Velocity
  909.  
  910.   oldx# = StartX
  911.   oldy# = StartY
  912.  
  913.   'draw gorilla toss
  914.   IF PlayerNum = 1 THEN
  915.     PUT (StartX, StartY), GorL&, PSET
  916.   ELSE
  917.     PUT (StartX, StartY), GorR&, PSET
  918.   END IF
  919.   
  920.   'throw sound
  921.   PLAY "MBo0L32A-L64CL16BL64A+"
  922.   Rest .1
  923.  
  924.   'redraw gorilla
  925.   PUT (StartX, StartY), GorD&, PSET
  926.  
  927.   adjust = Scl(4)                   'For scaling CGA
  928.  
  929.   xedge = Scl(9) * (2 - PlayerNum)  'Find leading edge of banana for check
  930.  
  931.   Impact = FALSE
  932.   ShotInSun = FALSE
  933.   OnScreen = TRUE
  934.   PlayerHit = 0
  935.   NeedErase = FALSE
  936.  
  937.   StartXPos = StartX
  938.   StartYPos = StartY - adjust - 3
  939.  
  940.   IF PlayerNum = 2 THEN
  941.     StartXPos = StartXPos + Scl(25)
  942.     direction = Scl(4)
  943.   ELSE
  944.     direction = Scl(-4)
  945.   END IF
  946.  
  947.   IF Velocity < 2 THEN              'Shot too slow - hit self
  948.     x# = StartX
  949.     y# = StartY
  950.     pointval = OBJECTCOLOR
  951.   END IF
  952.    
  953.   DO WHILE (NOT Impact) AND OnScreen
  954.  
  955.   Rest .02
  956.  
  957.   'Erase old banana, if necessary
  958.   IF NeedErase THEN
  959.     NeedErase = FALSE
  960.     CALL DrawBan(oldx#, oldy#, oldrot, FALSE)
  961.   END IF
  962.  
  963.   x# = StartXPos + (InitXVel# * t#) + (.5 * (Wind / 5) * t# ^ 2)
  964.   y# = StartYPos + ((-1 * (InitYVel# * t#)) + (.5 * gravity# * t# ^ 2)) * (ScrHeight / 350)
  965.          
  966.   IF (x# >= ScrWidth - Scl(10)) OR (x# <= 3) OR (y# >= ScrHeight - 3) THEN
  967.     OnScreen = FALSE
  968.   END IF
  969.  
  970.           
  971.   IF OnScreen AND y# > 0 THEN
  972.  
  973.     'check it
  974.     LookY = 0
  975.     LookX = Scl(8 * (2 - PlayerNum))
  976.     DO
  977.       pointval = POINT(x# + LookX, y# + LookY)
  978.       IF pointval = 0 THEN
  979.         Impact = FALSE
  980.         IF ShotInSun = TRUE THEN
  981.           IF ABS(ScrWidth \ 2 - x#) > Scl(20) OR y# > SunHt THEN ShotInSun = FALSE
  982.         END IF
  983.       ELSEIF pointval = SUNATTR AND y# < SunHt THEN
  984.         IF NOT SunHit THEN DoSun SUNSHOCK
  985.         SunHit = TRUE
  986.         ShotInSun = TRUE
  987.       ELSE
  988.         Impact = TRUE
  989.       END IF
  990.       LookX = LookX + direction
  991.       LookY = LookY + Scl(6)
  992.     LOOP UNTIL Impact OR LookX <> Scl(4)
  993.    
  994.     IF NOT ShotInSun AND NOT Impact THEN
  995.       'plot it
  996.       rot = (t# * 10) MOD 4
  997.       CALL DrawBan(x#, y#, rot, TRUE)
  998.       NeedErase = TRUE
  999.     END IF
  1000.             
  1001.     oldx# = x#
  1002.     oldy# = y#
  1003.     oldrot = rot
  1004.  
  1005.   END IF
  1006.  
  1007.       
  1008.   t# = t# + .1
  1009.  
  1010.   LOOP
  1011.  
  1012.   IF pointval <> OBJECTCOLOR AND Impact THEN
  1013.     CALL DoExplosion(x# + adjust, y# + adjust)
  1014.   ELSEIF pointval = OBJECTCOLOR THEN
  1015.     PlayerHit = ExplodeGorilla(x#, y#)
  1016.   END IF
  1017.  
  1018.   PlotShot = PlayerHit
  1019.  
  1020. END FUNCTION
  1021.  
  1022. 'Rest:
  1023. '  pauses the program
  1024. SUB Rest (t#)
  1025.   s# = TIMER
  1026.   t2# = MachSpeed * t# / SPEEDCONST
  1027.   DO
  1028.   LOOP UNTIL TIMER - s# > t2#
  1029. END SUB
  1030.  
  1031. 'Scl:
  1032. '  Pass the number in to scaling for cga.  If the number is a decimal, then we
  1033. '  want to scale down for cga or scale up for ega.  This allows a full range
  1034. '  of numbers to be generated for scaling.
  1035. '  (i.e. for 3 to get scaled to 1, pass in 2.9)
  1036. FUNCTION Scl (n!)
  1037.  
  1038.   IF n! <> INT(n!) THEN
  1039.       IF Mode = 1 THEN n! = n! - 1
  1040.   END IF
  1041.   IF Mode = 1 THEN
  1042.       Scl = CINT(n! / 2 + .1)
  1043.   ELSE
  1044.       Scl = CINT(n!)
  1045.   END IF
  1046.  
  1047. END FUNCTION
  1048.  
  1049. 'SetScreen:
  1050. '  Sets the appropriate color statements
  1051. SUB SetScreen
  1052.  
  1053.   IF Mode = 9 THEN
  1054.     ExplosionColor = 2
  1055.     BackColor = 1
  1056.     PALETTE 0, 1
  1057.     PALETTE 1, 46
  1058.     PALETTE 2, 44
  1059.     PALETTE 3, 54
  1060.     PALETTE 5, 7
  1061.     PALETTE 6, 4
  1062.     PALETTE 7, 3
  1063.     PALETTE 9, 63       'Display Color
  1064.   ELSE
  1065.     ExplosionColor = 2
  1066.     BackColor = 0
  1067.     COLOR BackColor, 2
  1068.  
  1069.   END IF
  1070.  
  1071. END SUB
  1072.  
  1073. 'SparklePause:
  1074. '  Creates flashing border for intro and game over screens
  1075. SUB SparklePause
  1076.  
  1077.   COLOR 4, 0
  1078.   A$ = "*    *    *    *    *    *    *    *    *    *    *    *    *    *    *    *    *    "
  1079.   WHILE INKEY$ <> "": WEND 'Clear keyboard buffer
  1080.  
  1081.   WHILE INKEY$ = ""
  1082.     FOR A = 1 TO 5
  1083.       LOCATE 1, 1                             'print horizontal sparkles
  1084.       PRINT MID$(A$, A, 80);
  1085.       LOCATE 22, 1
  1086.       PRINT MID$(A$, 6 - A, 80);
  1087.  
  1088.       FOR b = 2 TO 21                         'Print Vertical sparkles
  1089.         c = (A + b) MOD 5
  1090.         IF c = 1 THEN
  1091.           LOCATE b, 80
  1092.           PRINT "*";
  1093.           LOCATE 23 - b, 1
  1094.           PRINT "*";
  1095.         ELSE
  1096.           LOCATE b, 80
  1097.           PRINT " ";
  1098.           LOCATE 23 - b, 1
  1099.           PRINT " ";
  1100.         END IF
  1101.       NEXT b
  1102.     NEXT A
  1103.   WEND
  1104. END SUB
  1105.  
  1106. 'UpdateScores:
  1107. '  Updates players' scores
  1108. 'Parameters:
  1109. '  Record - players' scores
  1110. '  PlayerNum - player
  1111. '  Results - results of player's shot
  1112. SUB UpdateScores (Record(), PlayerNum, Results)
  1113.   IF Results = HITSELF THEN
  1114.     Record(ABS(PlayerNum - 3)) = Record(ABS(PlayerNum - 3)) + 1
  1115.   ELSE
  1116.     Record(PlayerNum) = Record(PlayerNum) + 1
  1117.   END IF
  1118. END SUB
  1119.  
  1120. 'VictoryDance:
  1121. '  gorilla dances after he has eliminated his opponent
  1122. 'Parameters:
  1123. '  Player - which gorilla is dancing
  1124. SUB VictoryDance (Player)
  1125.  
  1126.   FOR i# = 1 TO 4
  1127.     PUT (GorillaX(Player), GorillaY(Player)), GorL&, PSET
  1128.     PLAY "MFO0L32EFGEFDC"
  1129.     Rest .2
  1130.     PUT (GorillaX(Player), GorillaY(Player)), GorR&, PSET
  1131.     PLAY "MFO0L32EFGEFDC"
  1132.     Rest .2
  1133.   NEXT
  1134. END SUB
  1135.  
  1136.